home *** CD-ROM | disk | FTP | other *** search
/ Nebula 1 / Nebula One.iso / Internet / WWW / httpd_1.5.export / cgi-bin / mail < prev    next >
Encoding:
Text File  |  1995-11-10  |  12.9 KB  |  342 lines
  1. #!/usr/local/bin/perl 
  2.  
  3. # ======================================================================
  4. # WebMonitor Standalone Module: mail
  5. #
  6. #                               CGI script for providing form and script
  7. #                                to send mail to configured system users
  8. #
  9. # required files: mail.list
  10. #                                     Text file with users nicknames and
  11. #                                       email addresses in the format of
  12. #                                             <nickname>:<email address>
  13. #                      Keep "mail.list" in same directory as mail script
  14. #                                 NOTE: you can even have group aliases!
  15. #                                just separate the addresses with commas
  16. #         Make sure you 'chmod 0644 mail.list' so the server can read it
  17. #                             +-----------------------------------------
  18. #                   Example:  |webmaster:admin@machine
  19. #                             |john-doe:jdoe
  20. #                             |carlos:cpero@ncsa.uiuc.edu
  21. #                             |group:leader@domain.com,member@domain.com
  22. #                             +-----------------------------------------
  23. # ======================================================================
  24. # Carlos A. Pero (cpero@ncsa.uiuc.edu)              last update 10/17/95
  25. # ======================================================================
  26. # Documentation for WebMonitor can be found at
  27. #                          <URL:http://hoohoo.ncsa.uiuc.edu/webmonitor/>
  28. # ======================================================================
  29. # This code is in the public domain. Specifically, we give to the public
  30. # domain all rights for future licensing of the source code, all resale
  31. # rights, and all publishing rights.
  32. # 
  33. # We ask, but do not require, that the following message be included in
  34. # all derived works:
  35. # 
  36. # Portions developed at the National Center for Supercomputing
  37. # Applications at the University of Illinois at Urbana-Champaign.
  38. # 
  39. #
  40. # THE UNIVERSITY OF ILLINOIS GIVES NO WARRANTY, EXPRESSED OR IMPLIED,
  41. # FOR THE SOFTWARE AND/OR DOCUMENTATION PROVIDED, INCLUDING, WITHOUT
  42. # LIMITATION, WARRANTY OF MERCHANTABILITY AND WARRANTY OF FITNESS FOR A
  43. # PARTICULAR PURPOSE.
  44. # ======================================================================
  45. # For the greatest security, this script relies on a 'mail.list' file
  46. # with a list of authorized nicknames and email address which can receive
  47. # email through this mail script.
  48. #
  49. # For greater scalability, the '@AUTHDOMAINS' array can be used to store
  50. # a list of domains.  Any email address ending with one of these domains
  51. # can use this script to receive email.  In this case, the full email
  52. # address becomes the 'nickname'.
  53. # ======================================================================
  54. # This script can be referenced 2 ways for the best flexibility:
  55. #
  56. # DIRECTLY, <A HREF="/cgi-bin/mail?nickname">
  57. # This will generate an email form for the person named in 'nickname',
  58. # and if they exist in the 'mail.list' file.
  59. # If no 'nickname' is specified in the QUERY_STRING when the script is
  60. # first invoked, or the nickname cannot be found in the 'mail.list', 
  61. # an email form with a SELECT box of all valid nicknames is generated.
  62. # When the email form is submitted, it will call itself via method of POST,
  63. # and send the email to the recipient, outputting a confirmation message.
  64. # If the HTTP_REFERER was trasmitted when the script was first invoked,
  65. # there will be a hyperlink available to go back to that page (such as
  66. # the user's home page).
  67. #
  68. # FORWARDING RESULTS, <FORM METHOD="POST" ACTION="/cgi-bin/mail?nickname">
  69. # This will forward the results from the FORM, which can exist anywhere,
  70. # to the recipient specified by 'nickname'.  Since the 'nickname' is in
  71. # the QUERY_STRING, the FORM *must* use the METHOD="POST", otherwise the
  72. # recipient's nickname will be blown away.
  73. # Users may want to include a:
  74. #    <INPUT TYPE="hidden" NAME="next-url" VALUE="/~user/received.html">
  75. # If this is present in the FORM input, the client will be redirected
  76. # to this HTML file as a confirmation message instead of the default.
  77. # In addition, the user can also define any of the following input names
  78. # in their form to better customize the output mailed back to them.
  79. #    <INPUT TYPE="hidden" NAME="subject" VALUE="My survey results">
  80. #    <INPUT TYPE="hidden" NAME="from-name" VALUE="Average Web user">
  81. #    <INPUT TYPE="hidden" NAME="from-email" VALUE="jdoe@domain.com">
  82. # These values will then be used in the header of the email message.
  83. # Otherwise, default values will be substituted.
  84. # ======================================================================
  85.  
  86.  
  87. ########################################################################
  88. ########## Configurable variables ######################################
  89.  
  90. $SENDMAIL = '/usr/lib/sendmail';
  91. #                                   The location of your sendmail binary
  92.  
  93. @AUTHDOMAINS = ('');
  94. #           List of lower-case Internet domains that can use this script 
  95. #                                such as ('ncsa.uiuc.edu', 'domain.com')
  96.  
  97. ## Also, make sure the first line of this script points
  98. ## to your PERL binary
  99.  
  100. ########## Nothing else to change ######################################
  101. ########################################################################
  102.  
  103.  
  104. $ENV{'SCRIPT_NAME'} =~ m#(/.*/)(.*)$#;
  105. $SCRIPTDIR = $1;
  106. $SCRIPT = $2;
  107.  
  108. #### Do standard HTTP stuff ####
  109. &cgi_receive;
  110. &cgi_decode;
  111. &cgi_header;
  112.  
  113. #### Load mail.list into associative array ####
  114. open (MAILNAMES, "mail.list") || die ("$SCRIPT: Can't open mail.list: $!\n");
  115. while (<MAILNAMES>) {
  116.     chop;
  117.     ($nick, $addr) = split(/:/, $_);
  118.     $ADDRESS{$nick} = $addr;
  119. }
  120. close (MAILNAMES);
  121.  
  122. #### Figure out who the information should be sent to ####
  123. if ($ENV{'QUERY_STRING'} =~ /\@/) {
  124.     #### User specified a full email address ####
  125.     ($machine = $') =~ tr/A-Z/a-z/;
  126.     undef $FLAG{'authorized'};
  127.     for ($[ .. $#AUTHDOMAINS) {
  128.     $FLAG{'authorized'} = $AUTHDOMAINS[$_], last if ($ENV{'QUERY_STRING'} =~ /$AUTHDOMAINS[$_]$/);
  129.     }
  130.     &error_blank_field('an authorized email address') unless ($FLAG{'authorized'});
  131.     $recipient = $ENV{'QUERY_STRING'};
  132.     $extraaction = "?$recipient";
  133. }
  134. elsif ($ENV{'QUERY_STRING'}) {
  135.     #### User specified a nickname ####
  136.     $nickname = $ENV{'QUERY_STRING'};
  137.     &error_blank_field('a valid recipient nickname') unless ($ADDRESS{$nickname});
  138.     $recipient = $ADDRESS{$nickname};
  139.     $extraaction = "?$nickname";
  140. }
  141. elsif ($FORM{'nickname'}) {
  142.     #### Input is coming from listbox, ready for forwarding ####
  143.     $nickname = $FORM{'nickname'};
  144.     &error_blank_field('a valid recipient nickname') unless ($ADDRESS{$nickname});
  145.     $recipient = $ADDRESS{$FORM{'nickname'}};
  146. }
  147. elsif ($ENV{'REQUEST_METHOD'} eq "POST") {
  148.     #### I don't know who the information was for ####
  149.     &error_blank_field('a valid recipient');
  150. }
  151.  
  152. #### Output a default email form if not POSTing already ####
  153. &print_form unless ($ENV{'REQUEST_METHOD'} eq "POST");
  154.  
  155. #### Check for require fields
  156. foreach $field (@requirefields) {
  157.     &error_blank_field($field) unless ($FORM{$field});
  158. }
  159.  
  160. #### Fill in missing fields for forwarding FORM results ####
  161. ($FORM{'subject'}) || ($FORM{'subject'} = "FORM results");
  162. ($FORM{'from-email'}) || ($FORM{'from-email'} = $recipient);
  163. ($FORM{'from-name'}) || ($FORM{'from-name'} = "WebMonitor mail");
  164.  
  165. open (MAIL, "| $SENDMAIL $recipient") || die ("$SCRIPT: Can't open $mailprog: $!\n");
  166. print MAIL "Reply-to: $FORM{'from-email'} ($FORM{'from-name'})\n";
  167. print MAIL "From: $FORM{'from-email'} ($FORM{'from-name'})\n";
  168. print MAIL "To: $recipient\n";
  169. print MAIL "Subject: $FORM{'subject'}\n";
  170. print MAIL "X-Comments: =============================================================\n";
  171. print MAIL "X-Comments: NOTE:  This message was sent through the WebMonitor mail form\n";
  172. print MAIL "X-Comments: =============================================================\n";
  173. print MAIL "X-Comments: HOST:      $ENV{'REMOTE_HOST'} ($ENV{'REMOTE_ADDR'})\n";
  174. print MAIL "X-Comments: BROWSER:   $ENV{'HTTP_USER_AGENT'}\n";
  175. print MAIL "X-Comments: REFERER:   $FORM{'previous-url'}\n" if ($FORM{'previous-url'});
  176. print MAIL "X-Comments: =============================================================\n";
  177. print MAIL "\n";
  178. &dump_values(FORM, MAIL);
  179. print MAIL "\n";
  180. close (MAIL);
  181.  
  182. #### Now, redirect if "next-url" is included
  183. if ($FORM{'next-url'}) {
  184.     print "Location: $FORM{'next-url'}\n";
  185.     print "\n";
  186.     exit;
  187. }
  188.  
  189. #### Prevent HTML output
  190. foreach $key (keys %FORM) {
  191.     $FORM{$key} =~ s/</\</g;
  192.     $FORM{$key} =~ s/>/\>/g;
  193. }
  194.  
  195. #### Output confirmation message ####
  196. print qq|<HTML><HEAD><TITLE>WebMonitor-Email Sent</TITLE></HEAD><BODY>\n|;
  197. print qq|<H1>$ENV{'SERVER_NAME'} Email Sent</H1>\n|;
  198. print qq|The following message has been sent.\n|;
  199. print qq|You can now return to <A HREF="$FORM{'previous-url'}">where you were</A>.\n| if ($FORM{'previous-url'});
  200. print qq|<HR>\n|;
  201. print "<PRE>\n";
  202. print "Reply-to: $FORM{'from-email'} ($FORM{'from-name'})\n";
  203. print "From: $FORM{'from-email'} ($FORM{'from-name'})\n";
  204. print "To: $recipient\n";
  205. print "Subject: $FORM{'subject'}\n";
  206. print "\n";
  207. &dump_values(FORM, STDOUT);
  208. print "\n";
  209. print "</PRE>\n";
  210. print "</BODY></HTML>\n";
  211. exit;
  212.  
  213. #####################################################################
  214. #### SUBROUTINES ####################################################
  215.  
  216. sub error_blank_field {
  217.     local($variable) = @_;
  218.     print "\n" if ($FORM{'next-url'});
  219.     print "<HTML><HEAD><TITLE>WebMonitor-Email Error</TITLE></HEAD><BODY>\n";
  220.     print "<H1>Error!</H1>\n";
  221.     print "You did not fill in $variable.\n";
  222.     print "</BODY></HTML>\n";
  223.     exit;
  224. }
  225.  
  226. sub cgi_header {
  227.     print "Content-type: text/html\n";
  228.     print "\n" unless ($FORM{'next-url'});
  229. }        
  230.  
  231. sub cgi_receive {
  232.     if ($ENV{'REQUEST_METHOD'} eq "POST") {
  233.         read(STDIN, $incoming, $ENV{'CONTENT_LENGTH'});
  234.     }
  235.     else {
  236.         $incoming = $ENV{'QUERY_STRING'};
  237.     }
  238. }
  239.  
  240. sub cgi_decode {
  241.     @pairs = split(/&/, $incoming);
  242.  
  243.     foreach (@pairs) {
  244.         ($name, $value) = split(/=/, $_);
  245.  
  246.         $name  =~ tr/+/ /;
  247.         $value =~ tr/+/ /;
  248.         $name  =~ s/%([A-F0-9][A-F0-9])/pack("C", hex($1))/gie;
  249.         $value =~ s/%([A-F0-9][A-F0-9])/pack("C", hex($1))/gie;
  250.  
  251.         #### Strip out semicolons unless for special character
  252.         $value =~ s/;/$$/g;
  253.         $value =~ s/&(\S{1,6})$$/&\1;/g;
  254.         $value =~ s/$$/ /g;
  255.  
  256.         $value =~ s/\|/ /g;
  257.         $value =~ s/^!/ /g; ## Allow exclamation points in sentences
  258.  
  259.     #### Split apart any directive prefixes
  260.     #### NOTE: colons are reserved to delimit these prefixes
  261.     @parts = split(/:/, $name);
  262.     $name = $parts[$#parts];
  263.     if (grep(/^require$/, @parts)) {
  264.         push (@requirefields, $name);
  265.     }
  266.     if (grep(/^ignore$/, @parts)) {
  267.         push (@ignorefields, $name);
  268.     }
  269.     if (grep(/^dynamic$/, @parts)) {
  270.         #### For simulating a checkbox
  271.         #### It may be dynamic, but useless if nothing entered
  272.             next if ($value eq "");
  273.             $name = $value;
  274.             $value = "on";
  275.     }
  276.  
  277.         #### Skip generally blank fields
  278.         next if ($value eq "");
  279.  
  280.     #### Allow for multiple values of a single name
  281.         $FORM{$name} .= ", " if ($FORM{$name});
  282.  
  283.         $FORM{$name} .= $value;
  284.     #### Add to ordered list if not on list already
  285.         push (@fields, $name) unless (grep(/^$name$/, @fields));
  286.     }
  287. }
  288.  
  289. sub dump_values {
  290.     local($env, $handle) = @_;
  291.     ($handle eq "STDOUT") && (print $handle "<PRE>\n");
  292.     foreach $field (@fields) {
  293.     next if (grep(/^$field$/, @ignorefields));
  294.     if ($FORM{$field} =~ /[\cM\n]/) {
  295.         print $handle "($field)\n";
  296.         print $handle "-" x 75, "\n", $FORM{$field}, "\n", "-" x 75, "\n";
  297.     }
  298.     else {
  299.             print $handle "($field)  $FORM{$field}\n";
  300.     }
  301.     }
  302.     ($handle eq "STDOUT") && (print $handle "</PRE>\n");
  303. }
  304.  
  305. sub print_form {
  306.     print qq|<HTML><HEAD><TITLE>WebMonitor-Email Form</TITLE></HEAD><BODY>\n|;
  307.     print qq|<H1>$ENV{'SERVER_NAME'} <A HREF="http://hoohoo.ncsa.uiuc.edu/webmonitor/module-mail.html">Email Form</A></H1>\n|;
  308.     print qq|<FORM METHOD="POST" ACTION="$ENV{'SCRIPT_NAME'}$extraaction">\n|;
  309.     print qq|<HR>\n|;
  310.     print qq|<INPUT TYPE="submit" VALUE="Send Email"> to |;
  311.  
  312.     if ($nickname) {
  313.     print qq|<I>$recipient</I> <B>($nickname)</B>\n|;
  314.     }
  315.     elsif ($recipient) {
  316.     print qq|<I>$recipient</I>\n|;
  317.     }
  318.     else {
  319.     print qq|<SELECT NAME="ignore:nickname">\n|;
  320.     print qq|<OPTION>Select name...\n|;
  321.         foreach $nick (sort keys %ADDRESS) {
  322.         print qq|<OPTION>$nick\n|;
  323.         }
  324.         print qq|</SELECT>\n|;
  325.     }
  326.  
  327.  
  328.     print qq|<HR>\n|;
  329.     print qq|<PRE>|;
  330.     print qq|    Your Name: <INPUT NAME="require:ignore:from-name" SIZE="30">\n|;
  331.     print qq|Email Address: <INPUT NAME="require:ignore:from-email" SIZE="30">\n|;
  332.     print qq|      Subject: <INPUT NAME="ignore:require:subject" SIZE="40">    <INPUT TYPE="reset" VALUE="Clear Message">\n|;
  333.     print qq|</PRE>\n|;
  334.     print qq|<TEXTAREA NAME="require:message" ROWS="15" COLS="75"></TEXTAREA>\n|;
  335.     print qq|<INPUT TYPE="hidden" NAME="ignore:previous-url" VALUE="$ENV{'HTTP_REFERER'}">\n|;
  336.     print qq|</FORM>\n|;
  337.     print qq|</BODY></HTML>\n|;
  338.  
  339.     exit;
  340. }
  341.  
  342.